home *** CD-ROM | disk | FTP | other *** search
/ HTBasic 9.3 / HTBasic 9.3.iso / 83win / data1.cab / Basic_Plus_Examples / BMAPVIEW < prev    next >
Encoding:
Text File  |  2001-03-02  |  7.5 KB  |  206 lines
  1. 10   ! ******************************************************************
  2. 20    !
  3. 30   ! Example: Bitmap Viewer
  4. 40    !
  5. 50   ! This program demonstrates the use of the BITMAP widget. It
  6. 60   ! allows you to bring in and display bitmaps, as well as select
  7. 70   ! portions of them and save them in a file.
  8. 80    !
  9. 90   ! It also demonstrates the SCROLLABLE attribute for the PANEL ...
  10. 100   ! in particular the various operations needed to make SCROLL WIDTH
  11. 110   ! and SCROLL HEIGHT as correct as possible..
  12. 120   !
  13. 130   ! ******************************************************************
  14. 140   !
  15. 150   ! A few variables:
  16. 160   !
  17. 170   !   S$:        General-purpose string.
  18. 180   !   N:         General-purpose variable.
  19. 190   !   Btn:       Returns button value from dialogs.
  20. 200   !   Sc:        Scroll factor.
  21. 210   !   Bitfile$:  Name of bitmap file to be read.
  22. 220   !   Dirname$:  Directory name returned from FILE dialog.
  23. 230   !   B1$(*):    Stores MENU BUTTONS.
  24. 240   !   A1$,A2$:   Stores dialog attributes.
  25. 241       DLL UNLOAD ALL
  26. 250       DLL LOAD "HTBtree"
  27. 260       DLL GET "void HTBtree:Tctrl"
  28. 270       DIM S$[256]
  29. 280       INTEGER N,Btn,Sc
  30. 290       DIM Bitfile$[100],Dirname$[100],Btns$(1:3)[50],A1$[50],A2$[50]
  31. 300   !
  32. 310       DATA "BMP File","XWD File","Cancel","DIALOG BUTTONS","SELECTION",20
  33. 320       READ Btns$(*),A1$,A2$,Sc
  34. 330   !
  35. 340   ! Widget dimensions.
  36. 350   !
  37. 360       INTEGER Pw,Ph,Px,Py,Iw,Ih,Ww,Wh,Wx,Wy
  38. 370   !
  39. 380   ! Variables for display scaling.
  40. 390   !
  41. 400       INTEGER Cursor,D(1:4),Dw,Dh
  42. 410   !
  43. 420   ! Get display size.
  44. 430   !
  45. 440       GESCAPE CRT,3;D(*)
  46. 450       Dw=D(3)-D(1)
  47. 460       Dh=D(4)-D(2)
  48. 470   !
  49. 480       CLEAR SCREEN
  50. 490       KEY LABELS OFF
  51. 500       RUNLIGHT OFF
  52. 510       STATUS CRT,10;Cursor
  53. 520       CONTROL CRT,10;0
  54. 530   !
  55. 540       Pw=Dw*.7    ! PANEL width.
  56. 550       Ph=Dh*.7    ! PANEL height.
  57. 560       Px=(Dw-Pw)/2! Center PANEL.
  58. 570       Py=(Dh-Ph)/2
  59. 580   !
  60. 590   ! Create PANEL for BITMAP widget. Note how the SCROLL WIDTH
  61. 600   ! and HEIGHT are set to a small value so that scroll bars will not
  62. 610   ! appear initially. The actual heights are set later to fit the bitmap
  63. 620   ! that has been loaded.
  64. 630   !
  65. 640       ASSIGN @Main TO WIDGET "PANEL";SET ("VISIBLE":0)
  66. 650       CONTROL @Main;SET ("X":Px,"Y":Py,"WIDTH":Pw,"HEIGHT":Ph)
  67. 660       CONTROL @Main;SET ("TITLE":"Example: Bitmap Viewer")
  68. 670       CONTROL @Main;SET ("SIZE CONTROL":"SCROLLABLE","MINIMIZABLE":1)
  69. 680       CONTROL @Main;SET ("SCROLL WIDTH":1,"SCROLL WIDTH UNITS":Sc)
  70. 690       CONTROL @Main;SET ("SCROLL HEIGHT":1,"SCROLL HEIGHT UNITS":Sc)
  71. 700   !
  72. 710   ! Build menu.
  73. 720   !
  74. 730       ASSIGN @Menu TO WIDGET "PULLDOWN MENU";PARENT @Main
  75. 740       CONTROL @Menu;SET ("LABEL":"Menu")
  76. 750       ASSIGN @Getfile TO WIDGET "MENU BUTTON";PARENT @Menu
  77. 760       CONTROL @Getfile;SET ("LABEL":"Get Bitmap File")
  78. 770       ASSIGN @Savefile TO WIDGET "MENU BUTTON";PARENT @Menu
  79. 780       CONTROL @Savefile;SET ("LABEL":"Cut Bitmap To File")
  80. 790       ASSIGN @Cd TO WIDGET "MENU BUTTON";PARENT @Menu
  81. 800       CONTROL @Cd;SET ("LABEL":"Change Directory")
  82. 810       ASSIGN @S TO WIDGET "MENU SEPARATOR";PARENT @Menu
  83. 820       ASSIGN @Quit TO WIDGET "MENU BUTTON";PARENT @Menu
  84. 830       CONTROL @Quit;SET ("LABEL":"Quit")
  85. 840   !
  86. 850   ! Create and size BITMAP widget. (Setting RETAIN RASTER makes the
  87. 860   ! widget redraw quickly when overwritten by a dialog.)
  88. 870   !
  89. 880       ASSIGN @Bitmap TO WIDGET "BITMAP";PARENT @Main
  90. 890       CONTROL @Bitmap;SET ("RETAIN RASTER":1,"AUTO SIZE":1)
  91. 900       STATUS @Main;RETURN ("INSIDE WIDTH":Iw,"INSIDE HEIGHT":Ih)
  92. 910       Wx=Iw*.01
  93. 920       Wy=Ih*.01
  94. 930       Wh=Ih*.98
  95. 940       Ww=Iw*.98
  96. 950       CONTROL @Bitmap;SET ("X":Wx,"Y":Wy,"WIDTH":Ww,"HEIGHT":Wh)
  97. 960   !
  98. 970   ! Set events.
  99. 980   !
  100. 990       ON EVENT @Getfile,"ACTIVATED" GOSUB Getbitfile
  101. 1000       ON EVENT @Savefile,"ACTIVATED" GOSUB Savebits
  102. 1010       ON EVENT @Cd,"ACTIVATED" GOSUB Chdir
  103. 1020       ON EVENT @Quit,"ACTIVATED" GOTO Finis
  104. 1030  !
  105. 1040       CONTROL @Main;SET ("VISIBLE":1)
  106. 1050  !
  107. 1060  ! Loop and wait for input.
  108. 1070  !
  109. 1080       LOOP
  110. 1090       END LOOP
  111. 1100       STOP
  112. 1110  !
  113. 1120  ! *********************** End of Main Program **********************
  114. 1130  !
  115. 1140  ! This routine gets a bitmap file and displays it.  Note how it gets
  116. 1150  ! the bitmap size and sets up PANEL scrolling accordingly. Note also
  117. 1160  ! how it turns the BITMAP widget invisible so the display will
  118. 1170  ! "thrash" as little as possible.
  119. 1180  !
  120. 1190  Getbitfile:!
  121. 1200       S$="Please enter the name of a bitmap (.XWD or .BMP) file:"
  122. 1210       DIALOG "FILE",S$,Btn;RETURN ("SELECTION":Bitfile$)
  123. 1220  !
  124. 1230       IF Btn=0 THEN
  125. 1240           CLEAR ERROR
  126. 1250           ON ERROR GOSUB Errtrap
  127. 1260           CONTROL @Bitmap;SET ("VISIBLE":0,"BITMAP FILE":Bitfile$)
  128. 1270           OFF ERROR
  129. 1280           IF ERRN<>0 THEN
  130. 1290               DIALOG "ERROR","Can't open file / invalid bitmap file."
  131. 1300               CONTROL @Bitmap;SET ("BITMAP FILE":"","VISIBLE":1)
  132. 1310           ELSE
  133. 1320               CONTROL @Bitmap;SET ("VISIBLE":0)
  134. 1330               STATUS @Bitmap;RETURN ("BITMAP HEIGHT":Wh,"BITMAP WIDTH":Ww)
  135. 1340               CONTROL @Main;SET ("SCROLL HEIGHT":2+INT(Wh/Sc))
  136. 1350               CONTROL @Main;SET ("SCROLL WIDTH":2+INT(Ww/Sc))
  137. 1360               CONTROL @Bitmap;SET ("VISIBLE":1)
  138. 1370               DIALOG "INFORMATION","File read completed!"
  139. 1380           END IF
  140. 1390       END IF
  141. 1400       RETURN
  142. 1410  !
  143. 1420  ! This routine allows you to cut a section of a bitmap and
  144. 1430  ! save it in a file.  Note how string variables are used in
  145. 1440  ! the FILE dialog to specify the DIALOG BUTTONS attribute and
  146. 1450  ! the SELECTION attribute in order to keep the length of the
  147. 1460  ! statement compact.
  148. 1470  !
  149. 1480  Savebits:!
  150. 1490       S$="Enter file name, then click-and-drag image to save:"
  151. 1500       DIALOG "FILE",S$,Btn;SET (A1$:Btns$(*)),RETURN (A2$:Bitfile$)
  152. 1510  !
  153. 1520       SELECT Btn
  154. 1530       CASE 0
  155. 1540           S$="BMP"! Dump format is MS-Windows .BMP file.
  156. 1550       CASE 1
  157. 1560           S$="XWD"! Dump format is X11 XWD format.
  158. 1570       CASE 2
  159. 1580           RETURN
  160. 1590       END SELECT
  161. 1600  !
  162. 1610       CLEAR ERROR
  163. 1620       ON ERROR GOSUB Errtrap
  164. 1630       CONTROL @Bitmap;SET ("DUMP FORMAT":S$,"DUMP AREA":Bitfile$)
  165. 1640       OFF ERROR
  166. 1650       IF ERRN<>0 THEN
  167. 1660           DIALOG "ERROR","Can't open file."
  168. 1670       ELSE
  169. 1680           DIALOG "INFORMATION","Bitmap saved to "&S$&" file."
  170. 1690       END IF
  171. 1700  !
  172. 1710       RETURN
  173. 1720  !
  174. 1730  !
  175. 1740  ! This routine changes directories.
  176. 1750  !
  177. 1760  Chdir:!
  178. 1770       S$="Please enter the name of a directory:"
  179. 1780     !  DIALOG "FILE",S$,Btn;RETURN ("DIRECTORY":Dirname$)
  180. 1790       DIM Retstr$[260]
  181. 1800       Tctrl(S$,Dirname$)
  182. 1810       !
  183. 1820       Err=0
  184. 1830       CLEAR ERROR
  185. 1840       ON ERROR GOSUB Errtrap
  186. 1850       MASS STORAGE IS Dirname$
  187. 1860       OFF ERROR
  188. 1870       IF ERRN<>0 THEN
  189. 1880           DIALOG "ERROR","Can't change directory!"
  190. 1890       END IF
  191. 1900       RETURN
  192. 1910  !
  193. 1920  ! Dummy routine for trapping errors.
  194. 1930  !
  195. 1940  Errtrap: ERROR RETURN
  196. 1950  !
  197. 1960  ! ************** Go Here When Done ***********************
  198. 1970  !
  199. 1980  Finis:!
  200. 1990       ASSIGN @Main TO *
  201. 2000       CLEAR SCREEN
  202. 2010       KEY LABELS ON
  203. 2020       RUNLIGHT ON
  204. 2030       CONTROL CRT,10;Cursor
  205. 2040       END
  206.